1 - Entendimento do problema

A nossa empresa e seus investidores decidiram montar um time de futebol na Europa com a mesma qualidade dos melhores times europeus da atualidade. Para isso, solicitaram uma análise da equipe de BI sobre quais jogadores poderiam adquirir, desde que tivessem um preço competitivo. Devemos contratar 11 jogadores titulares para as seguintes posições:

Posição Descrição Jogadores
GK Goleiro 1
Center-back Zagueiro central 2
Outside-back Zagueiro lateral 2
Center-mid Meio de campo 2
Outside-mid Lateral 2
Forward Atacante 2

As posições detalhadas podem ser encontradas na figura a seguir:

1.1 Fonte das informações

Como não é possível medir todos os jogadores do mundo a partir de agora, o novo time considerou aceitável usar a base de dados com 17994 jogadores (originários do jogo Fifa 18).

  • As informações básicas dos jogadores estão no arquivo Excel:
  • As habilidades dos jogadores foram catalogadas na base de dados:
    • Servidor (host): 35.225.23.89
    • Tipo de Banco de dados: PostgreSQL (pacote RPostgres)
    • Porta (port): 55432
    • Database (db): fiapbi
    • Usuário (user): biuser
    • Senha (password): biuser
    • Schema e Tabela: futebol.habilities
  • As características físicas dos jogadores estão no mesmo banco de dados, porém em outra tabela:
    • Schema e Tabela: futebol.body
  • Os dados financeiros dos jogadores estão no arquivo CSV encontrado em:

1.2 Dicionário de dados

  • Informações dos jogadores:
    ID, name, full_name, club, club_logo, special, league, flag, nationality, photo, Position.

  • Habilidades do jogador (numéricos):
    crossing, finishing, heading_accuracy, short_passing, volleys, dribbling, curve, free_kick_accuracy, long_passing, ball_control, acceleration, sprint_speed, agility, reactions, balance, shot_power, jumping, stamina, strength, long_shots, aggression, interceptions, positioning, vision, penalties, composure, marking, standing_tackle, sliding_tackle, gk_diving, gk_handling, gk_kicking, gk_positioning, gk_reflexes.

  • Características físicas:
    Numéricos: age, height_cm, weight_kg.
    Categóricos: birth_date, body_type.
    Booleano: real_face

  • Dados financeiros (numéricos):
    eur_value, eur_wage, eur_release_clause


2 - Preparativos para a análise (Setup)

Para iniciarmos a análise é preciso instalar e carregar alguns pacotes. Esta seção é considerada um cabeçalho e evolui conforme a análise acontece.

Obs.: Caso sua estação não possua algum dos pacotes, é necessário instalar antes!

library(DBI) #Interface para base de dados
library(RPostgres) #Conexão com base de dados
library(readr) #Leitura de arquivo CSV
library(openxlsx) # Leitura de arquivo Excel
library(dplyr) #Manipulação de dados
library(plotly) #Gráficos Interativos
library(randomForest) #Aprendizado estatístico Advanced Analytics
library(magrittr)

A seguir, serão criadas algumas funções auxiliares que serão utilizadas em diversos trechos de análise.

#O professor criou a função abaixo para dar o display de um gráfico do plotly sempre com o mesmo tamanho
display.graph <- function(mygraph, width = 800, height = 500, margin = 0){
  ret <- mygraph %>% 
    layout(autosize = F, width = width, height = height, margin = margin) %>%
    config(showLink = F)
  return ( ret )
}

3 - Obtenção de dados

A seguir temos exemplos de obtenção de dados de arquivo csv, arquivo Excel e banco de dados. Utilize seu conhecimento para obter as informações requeridas indicadas na seção 1:

3.1 Exemplos:

# Exemplo Excel
exemplo.cameras <- read.xlsx("https://storage.googleapis.com/ds-publico/cameras.baltimore.xlsx")

# Exemplo CSV
exemplo.copas <- read_csv(url("https://storage.googleapis.com/ds-publico/Copas.csv"))
## Rows: 20 Columns: 10
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (6): Country, Winner, Runners-Up, Third, Fourth, Attendance
## dbl (4): Year, GoalsScored, QualifiedTeams, MatchesPlayed
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
# Exemplo DB
con <- dbConnect(Postgres(), host="35.225.23.89", port=55432,
                 db="fiapbi", user="biuser", password="biuser")

exemplo.starwars <- dbGetQuery(con, "SELECT * FROM public.starwars")
exemplo.school_persons <- dbGetQuery(con, "SELECT * FROM reports.school_persons")
dbDisconnect(con)
rm(con)

3.2 Obtenção dos dados

Insira na célula a seguir os passos para obtenção dos dados mencionados. Lembre-se de armazenar em variáveis com nomes apropriados.

## COLOQUE SUA RESPOSTA AQUI
players = read.xlsx("https://storage.googleapis.com/ds-publico/Fifa/jogadores.xlsx")

con = dbConnect(Postgres(), host="35.225.23.89", port=55432, db="fiapbi", user="biuser", password="biuser")

habilities = dbGetQuery(con, "SELECT * FROM futebol.habilities")
physical  = dbGetQuery(con, "SELECT * FROM futebol.body")

dbDisconnect(con)
rm(con)

finances = read_csv("https://storage.googleapis.com/ds-publico/Fifa/financial.csv")
## Rows: 17994 Columns: 4
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## dbl (4): ID, eur_value, eur_wage, eur_release_clause
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

3.3 Juntar todos os dados em fifa

Para facilitar todas as análises a seguir, crie uma tabela chamada fifa, com o “join” de todas as tabelas (use inner_join)

## COLOQUE SUA RESPOSTA AQUI
fifa = players %>% 
       inner_join(habilities,by="ID") %>% 
       inner_join(physical, by="ID") %>%
       inner_join(finances, by="ID")

3.4 Validações:

if(!'fifa' %in% ls()){
  print("Querido aluno, a tabela 'fifa' precisa existir!")
} else {
  print("Parece que está certo, vamos seguir!")
}
## [1] "Parece que está certo, vamos seguir!"

4 - Análise exploratória inicial

4.1 Conhecimento inicial dos dados

Todo processamento deve se iniciar de uma análise exploratória, ou seja, conhecer os dados que temos disponíveis.

Para isso, vamos usar alguns conceitos de estatística descritiva.

Os códigos a seguir exibem informações sobre uma tabela chamada mtcars, entre estes dados:
- Quantidade de linhas e colunas;
- Resumos estatísticos das colunas;
- Primeiros registros da tabela.

dim(mtcars)
## [1] 32 11
summary(mtcars)
##       mpg             cyl             disp             hp       
##  Min.   :10.40   Min.   :4.000   Min.   : 71.1   Min.   : 52.0  
##  1st Qu.:15.43   1st Qu.:4.000   1st Qu.:120.8   1st Qu.: 96.5  
##  Median :19.20   Median :6.000   Median :196.3   Median :123.0  
##  Mean   :20.09   Mean   :6.188   Mean   :230.7   Mean   :146.7  
##  3rd Qu.:22.80   3rd Qu.:8.000   3rd Qu.:326.0   3rd Qu.:180.0  
##  Max.   :33.90   Max.   :8.000   Max.   :472.0   Max.   :335.0  
##       drat             wt             qsec             vs        
##  Min.   :2.760   Min.   :1.513   Min.   :14.50   Min.   :0.0000  
##  1st Qu.:3.080   1st Qu.:2.581   1st Qu.:16.89   1st Qu.:0.0000  
##  Median :3.695   Median :3.325   Median :17.71   Median :0.0000  
##  Mean   :3.597   Mean   :3.217   Mean   :17.85   Mean   :0.4375  
##  3rd Qu.:3.920   3rd Qu.:3.610   3rd Qu.:18.90   3rd Qu.:1.0000  
##  Max.   :4.930   Max.   :5.424   Max.   :22.90   Max.   :1.0000  
##        am              gear            carb      
##  Min.   :0.0000   Min.   :3.000   Min.   :1.000  
##  1st Qu.:0.0000   1st Qu.:3.000   1st Qu.:2.000  
##  Median :0.0000   Median :4.000   Median :2.000  
##  Mean   :0.4062   Mean   :3.688   Mean   :2.812  
##  3rd Qu.:1.0000   3rd Qu.:4.000   3rd Qu.:4.000  
##  Max.   :1.0000   Max.   :5.000   Max.   :8.000
head(mtcars)

Use o exemplo acima e informe :

dim(fifa)
## [1] 17994    49
summary(fifa)
##        ID             name            full_name             club          
##  Min.   :    16   Length:17994       Length:17994       Length:17994      
##  1st Qu.:192621   Class :character   Class :character   Class :character  
##  Median :214186   Mode  :character   Mode  :character   Mode  :character  
##  Mean   :207792                                                           
##  3rd Qu.:231616                                                           
##  Max.   :241489                                                           
##                                                                           
##     special        league          nationality          Position        
##  Min.   : 728   Length:17994       Length:17994       Length:17994      
##  1st Qu.:1450   Class :character   Class :character   Class :character  
##  Median :1634   Mode  :character   Mode  :character   Mode  :character  
##  Mean   :1594                                                           
##  3rd Qu.:1785                                                           
##  Max.   :2291                                                           
##                                                                         
##     crossing       finishing     heading_accuracy short_passing  
##  Min.   : 5.00   Min.   : 2.00   Min.   : 4.00    Min.   :10.00  
##  1st Qu.:38.00   1st Qu.:29.00   1st Qu.:45.00    1st Qu.:53.00  
##  Median :54.00   Median :48.00   Median :56.00    Median :62.00  
##  Mean   :49.81   Mean   :45.33   Mean   :52.38    Mean   :58.34  
##  3rd Qu.:64.00   3rd Qu.:61.75   3rd Qu.:64.00    3rd Qu.:68.00  
##  Max.   :90.00   Max.   :95.00   Max.   :94.00    Max.   :92.00  
##                                                                  
##     volleys        dribbling         curve       free_kick_accuracy
##  Min.   : 4.00   Min.   : 2.00   Min.   : 6.00   Min.   : 4.00     
##  1st Qu.:30.00   1st Qu.:48.00   1st Qu.:34.00   1st Qu.:31.00     
##  Median :44.00   Median :61.00   Median :49.00   Median :42.00     
##  Mean   :43.23   Mean   :55.11   Mean   :47.33   Mean   :43.17     
##  3rd Qu.:57.00   3rd Qu.:68.00   3rd Qu.:62.00   3rd Qu.:57.00     
##  Max.   :91.00   Max.   :97.00   Max.   :92.00   Max.   :93.00     
##                                                                    
##   long_passing    ball_control    acceleration    sprint_speed  
##  Min.   : 7.00   Min.   : 8.00   Min.   :11.00   Min.   :11.00  
##  1st Qu.:42.00   1st Qu.:53.00   1st Qu.:57.00   1st Qu.:57.00  
##  Median :56.00   Median :63.00   Median :67.00   Median :67.00  
##  Mean   :52.48   Mean   :58.14   Mean   :64.65   Mean   :64.89  
##  3rd Qu.:64.00   3rd Qu.:69.00   3rd Qu.:75.00   3rd Qu.:75.00  
##  Max.   :93.00   Max.   :95.00   Max.   :96.00   Max.   :96.00  
##                                                                 
##     agility        reactions       balance        shot_power       jumping     
##  Min.   :14.00   Min.   :28.0   Min.   :11.00   Min.   : 3.00   Min.   :13.00  
##  1st Qu.:55.00   1st Qu.:56.0   1st Qu.:56.00   1st Qu.:46.00   1st Qu.:58.00  
##  Median :65.00   Median :62.0   Median :66.00   Median :59.00   Median :66.00  
##  Mean   :63.35   Mean   :61.9   Mean   :63.81   Mean   :55.67   Mean   :64.89  
##  3rd Qu.:74.00   3rd Qu.:68.0   3rd Qu.:74.00   3rd Qu.:69.00   3rd Qu.:73.00  
##  Max.   :96.00   Max.   :96.0   Max.   :96.00   Max.   :94.00   Max.   :95.00  
##                                                                                
##     stamina        strength       long_shots      aggression    interceptions  
##  Min.   :12.0   Min.   :12.00   Min.   : 3.00   Min.   :11.00   Min.   : 4.00  
##  1st Qu.:56.0   1st Qu.:58.00   1st Qu.:33.00   1st Qu.:43.00   1st Qu.:26.00  
##  Median :66.0   Median :66.00   Median :51.00   Median :59.00   Median :52.00  
##  Mean   :63.3   Mean   :65.29   Mean   :47.24   Mean   :55.83   Mean   :46.58  
##  3rd Qu.:74.0   3rd Qu.:74.00   3rd Qu.:63.00   3rd Qu.:69.00   3rd Qu.:64.00  
##  Max.   :95.0   Max.   :98.00   Max.   :92.00   Max.   :96.00   Max.   :92.00  
##                                                                                
##   positioning        vision        penalties       composure    
##  Min.   : 2.00   Min.   :10.00   Min.   : 5.00   Min.   : 5.00  
##  1st Qu.:38.00   1st Qu.:43.00   1st Qu.:39.00   1st Qu.:51.00  
##  Median :55.00   Median :55.00   Median :50.00   Median :60.00  
##  Mean   :49.68   Mean   :53.03   Mean   :48.99   Mean   :57.89  
##  3rd Qu.:64.00   3rd Qu.:64.00   3rd Qu.:61.00   3rd Qu.:67.00  
##  Max.   :95.00   Max.   :94.00   Max.   :92.00   Max.   :96.00  
##                                                                 
##     marking      standing_tackle sliding_tackle    gk_diving     gk_handling   
##  Min.   : 4.00   Min.   : 4.00   Min.   : 4.00   Min.   : 1.0   Min.   : 1.00  
##  1st Qu.:22.00   1st Qu.:26.00   1st Qu.:24.00   1st Qu.: 8.0   1st Qu.: 8.00  
##  Median :48.00   Median :54.00   Median :52.00   Median :11.0   Median :11.00  
##  Mean   :44.12   Mean   :47.48   Mean   :45.59   Mean   :16.7   Mean   :16.48  
##  3rd Qu.:63.00   3rd Qu.:66.00   3rd Qu.:64.00   3rd Qu.:14.0   3rd Qu.:14.00  
##  Max.   :92.00   Max.   :92.00   Max.   :91.00   Max.   :91.0   Max.   :91.00  
##                                                                                
##    gk_kicking    gk_positioning   gk_reflexes         age       
##  Min.   : 1.00   Min.   : 1.00   Min.   : 1.00   Min.   :16.00  
##  1st Qu.: 8.00   1st Qu.: 8.00   1st Qu.: 8.00   1st Qu.:21.00  
##  Median :11.00   Median :11.00   Median :11.00   Median :25.00  
##  Mean   :16.36   Mean   :16.47   Mean   :16.83   Mean   :25.12  
##  3rd Qu.:14.00   3rd Qu.:14.00   3rd Qu.:14.00   3rd Qu.:28.00  
##  Max.   :95.00   Max.   :91.00   Max.   :90.00   Max.   :47.00  
##                                                                 
##    height_cm       weight_kg      birth_date          eur_value        
##  Min.   :155.0   Min.   : 49.0   Length:17994       Min.   :        0  
##  1st Qu.:177.0   1st Qu.: 70.0   Class :character   1st Qu.:   300000  
##  Median :181.0   Median : 75.0   Mode  :character   Median :   700000  
##  Mean   :181.3   Mean   : 75.4                      Mean   :  2370511  
##  3rd Qu.:186.0   3rd Qu.: 80.0                      3rd Qu.:  2000000  
##  Max.   :205.0   Max.   :110.0                      Max.   :123000000  
##                                                                        
##     eur_wage      eur_release_clause 
##  Min.   :     0   Min.   :    13000  
##  1st Qu.:  2000   1st Qu.:   528000  
##  Median :  4000   Median :  1200000  
##  Mean   : 11504   Mean   :  4449111  
##  3rd Qu.: 12000   3rd Qu.:  3600000  
##  Max.   :565000   Max.   :236800000  
##                   NA's   :1494
  • Qual a quantidade de jogadores no arquivo de jogadores: 17994

  • Qual o salário médio dos jogadores, em Euro: 11504

4.2 Ligas disponíveis e ligas de referência

O exemplo abaixo exibe quantas espécies diferentes temos na tabela exemplo.starwars

length( unique(exemplo.starwars$species) )
## [1] 38

Baseado nisso, quantos Clubes e quantas ligas temos disponíveis:

length(unique(fifa$club))
## [1] 648
length(unique(fifa$league))
## [1] 42
  • Clubes: 648
  • Ligas: 42

Quantos jogadores temos em cada liga? Use o exemplo abaixo para responder.

exemplo.starwars %>%
  group_by(species) %>%
  summarise(Personagens = n()) %>%
  arrange(desc(Personagens))

Reposta:

fifa %>%
  group_by(league) %>%
  summarise(players = n()) %>%
  arrange(desc(players))

4.3 Liga de referência! (as melhores, segundo o prefessor) !

Nossa base de dados possui 647 times divididos em 41 ligas. As seguintes ligas serão selecionadas como as melhores ligas para análise dos jogadores:
- English Championship
- French Ligue 1
- German Bundesliga
- Spanish Primera División
- Italian Serie A (ok, sei que há controvérsias)

Para faciliar nosso trabalho futuro, armazenamos as ligas de referência selecionadas no vetor best_leagues:

best_leagues = c("English Championship", "French Ligue 1", "German Bundesliga", "Spanish Primera División", "Italian Serie A")
best_species = c("Droid", "Mirialan")

Agora exiba um gráfico nos informando quantos jogadores estão na liga de referência. Veja o exemplo abaixo que exibe quantos personages estão nas espécies de referência:

exemplo.starwars %>%
  group_by(species) %>%
  summarise(Personagens = n()) %>%
  arrange(desc(Personagens)) %>%
  mutate( Referencia = species %in% best_species) -> exemplo.agregacao
print(exemplo.agregacao)
## # A tibble: 38 × 3
##    species  Personagens Referencia
##    <chr>          <int> <lgl>     
##  1 Human             35 FALSE     
##  2 Droid              6 TRUE      
##  3 NA                 4 FALSE     
##  4 Gungan             3 FALSE     
##  5 Kaminoan           2 FALSE     
##  6 Mirialan           2 TRUE      
##  7 Twi'lek            2 FALSE     
##  8 Wookiee            2 FALSE     
##  9 Zabrak             2 FALSE     
## 10 Aleena             1 FALSE     
## # … with 28 more rows
## COLOQUE SUA RESPOSTA AQUI
n_players_by_league = fifa %>%
  group_by(league) %>%
  summarise(players = n()) %>%
  arrange(desc(players)) %>%
  mutate(reference = league %in% best_leagues) %T>%
  print()
## # A tibble: 42 × 3
##    league                   players reference
##    <chr>                      <int> <lgl>    
##  1 Argentinian Superliga        780 FALSE    
##  2 English Championship         717 TRUE     
##  3 English League One           668 FALSE    
##  4 English Premier League       654 FALSE    
##  5 Spanish Segunda División     637 FALSE    
##  6 English League Two           633 FALSE    
##  7 Italian Serie B              625 FALSE    
##  8 USA Major League Soccer      625 FALSE    
##  9 Spanish Primera División     602 TRUE     
## 10 French Ligue 1               598 TRUE     
## # … with 32 more rows

4.4 Gráfico de barras

Exiba o gráfico de barras de todas as ligas, destacando as que são ligas de referência. Use o exemplo abaixo:

grafico <- exemplo.agregacao %>%
  filter(Referencia == F) %>%
  plot_ly(x = ~species, y = ~Personagens, color = ~Referencia, type = 'bar', name="Outras")
grafico <- grafico %>% add_bars(x = ~species, y = ~Personagens, color = ~Referencia, data = exemplo.agregacao[exemplo.agregacao$Referencia==T,], name="Best")


display.graph(grafico)

Minhas ligas, se tudo der certo, um gráfico como este deve ser exibido:

n_players_by_league %>%
  filter(reference == FALSE) %>%
  plot_ly(x = ~league, y = ~players, color = ~reference, type = 'bar', name = 'other') %>%
  add_bars(x = ~league, y = ~players, color = ~reference, data = filter(n_players_by_league, reference == TRUE), name = "best") %T>% display.graph()

5 - Análise Características físicas dos jogadores

Será que há diferenças físicas entre jogadores das ligas diferentes? Veja o exemplo a seguir:

par(mfrow=c(2,1))
exemplo.school_persons %>%
  filter(gender=="men") %>%
  .$earnings %>%
  hist(xlim=c(0, 300), main="Homens")
exemplo.school_persons %>%
  filter(gender=="women") %>%
  .$earnings %>%
  hist(xlim=c(0, 300), main="Mulheres")

par(mfrow=c(1,1))

Agora mostre a distribuição de altura dos ATACANTES ( Forward) das melhores ligas acima e das demais ligas abaixo.

par(mfrow=c(2,1))
forwards = filter(fifa, Position == "Forward")
forwards %>% filter(not(league %in% best_leagues)) %>% .$height_cm %>% hist(main = "other", xlim=c(150, 210), breaks = 20)
forwards %>% filter(league %in% best_leagues) %>% .$height_cm %>% hist(main = "best", xlim=c(150, 210), breaks= 20)

par(mfrow=c(1,1))

Exemplo de uma imagem esperada:

5.2 EXTRA! Exemplo de análises mais detalhadas.

if(!'fifa' %in% ls()){
  fifa <- read_csv("https://storage.googleapis.com/ds-publico/fifa%20game-3.csv",
                   locale = locale(encoding = "UTF-8"))
}
fifa <- fifa %>%
  mutate(Selected = league %in% best_leagues)

analise_posicao <- function(coluna, nome_col){
  fig <- fifa %>% plot_ly(type = 'violin') 
  
  fig <- fig %>%
    add_trace(
      x = ~Position[fifa$Selected == T],
      y = ~coluna[fifa$Selected == T],
      legendgroup = 'Top',
      scalegroup = 'Top',
      name = 'Top',
      side = 'negative',
      box = list( visible = T ),
      meanline = list( visible = T ),
      color = I("blue")
    ) 
  fig <- fig %>%
    add_trace(
      x = ~Position[fifa$Selected == F],
      y = ~coluna[fifa$Selected == F],
      legendgroup = 'Outras',
      scalegroup = 'Outras',
      name = 'Outras',
      side = 'positive',
      box = list( visible = T ),
      meanline = list( visible = T ),
      color = I("#449944")
    ) 
  
  fig <- fig %>%
    layout(
      xaxis = list( title = "Posição" ),
      yaxis = list( title = nome_col, zeroline = F ),
      violingap = 0,
      violingroupgap = 0,
      violinmode = 'overlay'
    )
  
  return(display.graph(fig))
}
analise_posicao(fifa$age, "Idade")
analise_posicao(fifa$height_cm, "Altura (cm)")
analise_posicao(fifa$weight_kg, "Peso (kg)")
analise_posicao(fifa$eur_value, "Valor de compra(EUR)")
analise_posicao(fifa$eur_wage, "Salário (EUR)")

E então podemos fazer as análises sobre essas características. Nas figuras podemos ver que os jogadores das ligas selecionadas são mais novos do que das demais ligas, independentes da posição enquanto que os jogadores das ligas não selecionadas tem um salário menor, independentemente da posição. O interessante dessas análises é que é possível ver a estatística descritiva de uma forma muito mais natural, incluindo médias, medianas, quartis, máximos e mínimos, além de uma curva de distribuição.

Como o objetivo é mostrar o poder da ferramenta, de forma não exaustiva, vou parar a análise exploratória por aqui. Percebam que com poucas linhas de código, conseguimos gerar gráficos interativos totalmente customizadas. Agora, deixarei as demais análises exploratórias para vocês e partir para a proposta de resolução do problema: Escolher nossos 11 jogadores, bons e baratos!

6 - Proposta de resolução do problema

Para resolver este problema, vamos tentar obter o preço justo do jogador (eur_value), baseado apenas em suas habilidades, identificadas no dicionário de dados.

Se estivéssemos olhando apenas uma habilidade, como dribbling, para atacantes, por exemplo, poderíamos traçar uma média, de acordo com essa habilidade, correto? Neste caso, poderíamos traçar um gráfico como este, presente na a seguir, em que cada ponto azul representa um atacante, e cada ponto laranja o salário médio dos atacantes que possuem a mesma nota de dribbling.

# CELULA APENAS PARA DEMONSTRACAO

#Obtém jogadores de referência e armazena em j_ref
j_ref <- fifa %>%
  filter(Position == "Forward") %>%
  filter(league %in% best_leagues)

# Obtem a media destes jogadores, POR dribbling e armazena em vlmedio
vlmedio <- j_ref %>%
  group_by(dribbling) %>%
  summarise(eur_value = mean(eur_value, na.rm = TRUE)) %>%
  mutate(descricao = paste("Média de dribbling ", dribbling) ) %>%
  select(dribbling, descricao, eur_value)
  
#Cria gráfico dos jogadores
fig <- plot_ly(j_ref, x = ~dribbling, y = ~eur_value,
               text=~full_name, type='scatter', mode='markers',
               name="Jogadores")

# Adiciona as médias
fig <- add_trace(fig, data=vlmedio,
                 x = ~dribbling, y = ~eur_value,
                 type='scatter', mode='markers', text= ~ paste("Media de", dribbling),
                 name="Médias" )

display.graph(fig)

Mas como fazer isso considerando mais do que uma habilidade? E se quisermos considerar todas as habilidades para definir o preço justo do jogador?

Sim, isso não apenas é possível como existem muitas técnicas possíveis para se chegar a este resultado. É preciso de um pouco de conhecimento estatístico ou de aprendizado de máquina, mas utilizar uma ferramenta como o R é o que diferencia grandes análises, podendo ultrapassar as análises dos simples relatórios explicativos.

Para este caso, vou usar um algoritmo de Breiman e Cutler chamado de Random Forest para Regressão. Trata-se de um modelo de aprendizado estatístico que avalia as diversas características (habilidades do jogador) e estabelece qual seria a resposta do modelo (valor do jogador).

6.1. Modelo ATACANTES usando Random Forest

O código a seguir, separa em um vetor chamado “habilidades”, qual seriam as variáveis importantes para o modelo.

habilidades <- c("crossing", "finishing", "heading_accuracy", "short_passing", "volleys", "dribbling",  "curve", "free_kick_accuracy", "long_passing",  "ball_control", "acceleration", "sprint_speed",  "agility", "reactions", "balance",  "shot_power", "jumping", "stamina",  "strength", "long_shots", "aggression",  "interceptions", "positioning", "vision",  "penalties", "composure", "marking",  "standing_tackle", "sliding_tackle", "gk_diving",  "gk_handling", "gk_kicking", "gk_positioning",  "gk_reflexes")

Então, inicialmente fazemos o modelo estatístico para identificar os atacantes que tem os valores mais divergentes de acordo com usas habilidades. O trecho de código a seguir, faz justamente isso, ou seja, de acordo com suas habilidades identifica qual seria o valor justo para os atacantes.

6.1.1 - Prepara dados

Filtra apenas jogadores de referência e armazena em referencia.df

position = "Forward"
referencia.df <- fifa %>%
  filter(league %in% best_leagues) %>%
  filter(Position == position) %>%
  select(Position, eur_value, habilidades)
## Note: Using an external vector in selections is ambiguous.
## ℹ Use `all_of(habilidades)` instead of `habilidades` to silence this message.
## ℹ See <https://tidyselect.r-lib.org/reference/faq-external-vector.html>.
## This message is displayed once per session.
#Remove casos que estejam incompletos
referencia.df <- referencia.df[complete.cases(referencia.df), ]

6.1.2 - Cria o modelo estatistico

Cria modelo usando RandomForest e armazena em referencia.rf

referencia.rf <- randomForest( eur_value~., data=referencia.df)
fifa %>%
  filter(!league %in% best_leagues) %>%
  filter(Position == position) %>%
  mutate(valor_justo = predict(referencia.rf, .),
         diferenca = eur_value - valor_justo) %>%
  select(ID, name, club, league, eur_value, valor_justo, diferenca) -> analise.atacantes

E para ter uma visão gráfica desta diferença entre valor de mercado e valor justo, temos o código a seguir que gera a figura. Nesta imagem, identificamos que o jogador “Z.Ibrahimovic” custa cerca de 18 milhões de euros a menos do que suas habilidades dizem que ele vale, logo, seria uma ótima aquisição para o clube.

plot_ly() -> fig
fig <- fig %>%
  add_trace(data = analise.atacantes, x= ~eur_value, y= ~valor_justo,
            text=~paste(name, "\nValor Merc:", sprintf("%.2f",eur_value),
                        "\nValor Justo:", sprintf("%.2f",valor_justo),
                        "\nDiferença:", sprintf("%.2f",diferenca)),
            name="Jogadores",
            type='scatter', mode='markers') %>%
  add_segments(x = 0, xend = 1e8, y = 0, yend = 1e8, name="Equilíbrio")
display.graph(fig)
# função auxiliar para exercicios 6.2 e 6.3


create_fair_value_model = . %>% 
  filter(league %in% best_leagues) %>%
  select(Position, eur_value, all_of(habilidades)) %>%
  (function (x) { x[complete.cases(x), ] }) %>%
  randomForest(eur_value~., data=.)

create_prediction_dt = function (data, rf) {
  data %>%
    filter(!league %in% best_leagues) %>%
    mutate(fair_value = predict(rf, .), gap = eur_value - fair_value) %>%
    select(ID, name, club, league, eur_value, fair_value, gap)
}

predict_fair_value = function (data, ...) {
  players = data %>% filter(Position %in% c(...))
  players.random_forest = players %>% create_fair_value_model
  players.prediction = create_prediction_dt(players,
                                            players.random_forest)
  players.prediction
}

plot_advanced_analytics = function (data, ...) {
  players.prediction = predict_fair_value(data, ...)
  plot_ly() -> fig
  fig <- fig %>%
  add_trace(data = players.prediction, x= ~eur_value, y= ~fair_value,
            text=~paste(name, "\nValor Merc:", sprintf("%.2f",eur_value),
                        "\nValor Justo:", sprintf("%.2f",fair_value),
                        "\nDiferença:", sprintf("%.2f",gap)),
            name="Jogadores",
            type='scatter', mode='markers') %>%
  add_segments(x = 0, xend = 1e8, y = 0, yend = 1e8, name="Equilíbrio")
  display.graph(fig)
}

6.2. Faça um modelo de Advanced Analytics para Meio Campistas

plot_advanced_analytics(fifa, "Outside-mid", "Center-mid")

6.3. Faça um modelo de Advanced Analytics para Zaqueiros Centrais

plot_advanced_analytics(fifa, "Outside-back", "Center-back")

7 - Conclusão

Espaço para a conclusão

f = predict_fair_value(fifa, "Forward")
m = predict_fair_value(fifa, "Outside-mid", "Center-mid")
b = predict_fair_value(fifa, "Outside-back", "Center-back")
f[order(f$gap), c("name", "gap", "club")]
m[order(m$gap), c("name", "gap", "club")]
b[order(b$gap), c("name", "gap", "club")]

Diga quais dois Atacantes poderiam ser adquiridos pelo clube e comente o motivo: Z. Ibrahimovic, Jonas

Diga quais dois Meio Campistas poderiam ser adquiridos pelo clube e comente o motivo: A. Witsel, Adrien Silva

Diga quais dois Zaqueiros Centrais poderiam ser adquiridos pelo clube e comente o motivo: P. Mertesacker, D. Srna